Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/netmail/rnr214.zip/GETFNAME.PAS

Pascal/Delphi Source File | 1996-02-02 | 31KB | 1,316 lines

program getfname;

{
[e-mail] (960202)

Copyright 1996 Russell Schulz

this code is not in the Public Domain

permission is granted to use these routines in any application regardless
of commercial status as long as the author of these routines assumes no
liability for any damages whatsoever for any reason.  have fun.
}

uses dos,crt,genericf,linedraw;

const
  esc=#27;
  shiftedtab=#209;  {this is _ugly_}
  altf=#210;  {this is _ugly_}
  altp=#211;  {this is _ugly_}
  altd=#212;  {this is _ugly_}
  alto=#213;  {this is _ugly_}
  altc=#214;  {this is _ugly_}

type
  filenamet=string[12];  {8.3}
  datetimet=string[16];  {YYYY-MM-DD HH:MM}

  filenodep=^filenode;
  filenode=
    record
      filename: filenamet;
      datetime: datetimet;
      size: longint;
      next: filenodep;
    end;

var
  outputfn: string;
  title: string;
  filemustexist: boolean;
  maxtofind: integer;
  warnifexists: boolean;
  allowmkdir: boolean;
  pattern: string;
  currpath: string;
  driveletters: string;
  vikeys: boolean;

  dialogx,dialogy: integer;
  dialogwidth,dialogheight: integer;

  oldtextattr: byte;

  outputf: text;
  labels: array[1..26] of string;
  filehead: filenodep;
  pathhead: filenodep;
  drivehead: filenodep;
  reusehead: filenodep;

  titlwithpath: string;
  resultingfn: string;

  underdialog: savedbytes;

  startupx,startupy: integer;

procedure usage;

begin
  writeln('usage:  getfname [options] required');
  writeln;
  writeln('required:');
  writeln('  -o output-filename');
  writeln;
  writeln('options:');
  writeln('  -t title');
  writeln('  -e file must exist');
  writeln('  -m maximum # of files to return (now can only be 1)');
  writeln('  -w warn if it exists');
  writeln('  -i initial pattern');
  writeln('  -n don''t allow mkdir');
  writeln('  -p path to start in');
  writeln('  -d drive letters to check (e.g., CDZ)');
  writeln('  -v use vi keys (j and k; but not ^F and ^B, sorry)');
  writeln;
  writeln('[e-mail] (960202)');
  halt(1);
end;

procedure msgusage(s: string);

begin
  writeln(s);
  usage;
end;

function withzero(i: integer): string;

begin
  withzero := chr(ord('0')+(i div 10))+chr(ord('0')+(i mod 10));
end;

function withoutlastdir(apath: string): string;

var
  result: string;
  newlength: integer;
  tempint: integer;

begin
  result := apath;

  if numoccur('\',withbackslash(result))>1 then
    begin
      newlength := length(result);  {not needed}

      for tempint := 1 to length(result) do
        if result[tempint]='\' then
          newlength := tempint-1;

      result := copy(result,1,newlength);
      if right(result,1)=':' then
        result := result+'\';
    end;

{
  if right(result,1)='\' then
    if length(result)>1 then
      if right(result,2)<>':\' then
        result := copy(result,1,length(result)-1);
}

  withoutlastdir := result;
end;

function unlabel(labelfn: string): string;

begin
  unlabel := copy(labelfn,1,8)+copy(labelfn,10,255);  {skip the implied .}
end;

function prevptr(aptr: filenodep; ahead: filenodep): filenodep;

var
  result: filenodep;
  found: boolean;

begin
  result := ahead;
  found := false;

  while (result<>nil) and not found do
    begin
      if result^.next=aptr then
        found := true
      else
        result := result^.next;
    end;

{
  if not found then
    writeln('internal error:  could not find prev');
}

  prevptr := result;
end;

procedure sortlist(var ahead: filenodep);

var
  newhead: filenodep;
  lastsofar: filenodep;
  lastnamesofar: filenamet;
  prevtolast: filenodep;
  current: filenodep;

begin
  newhead := nil;

  while ahead<>nil do
    begin
      lastsofar := ahead;
      lastnamesofar := ahead^.filename;

      current := lastsofar^.next;
      while current<>nil do
        begin
          if current^.filename>lastnamesofar then
            begin
              lastsofar := current;
              lastnamesofar := current^.filename;
            end;

          current := current^.next;
        end;

{remove from list}
      if lastsofar=ahead then
        ahead := ahead^.next
      else
        begin
          prevtolast := prevptr(lastsofar,ahead);
          prevtolast^.next := lastsofar^.next;
        end;

{add to new head}
      lastsofar^.next := newhead;
      newhead := lastsofar;
    end;

  ahead := newhead;
end;

procedure reversevideo;

begin
  textattr := black+white*8;
{
  textcolor(red);
}
end;

procedure enhancedvideo;

begin
  textattr := blue;
{
  textcolor(blue);
}
end;

procedure normalvideo;

begin
  textattr := oldtextattr;
{
  textcolor(white);
}
end;

procedure reuse(var ahead: filenodep);

var
  aptr: filenodep;

begin
  if reusehead=nil then
    reusehead := ahead
  else
    begin
      aptr := reusehead;
      while aptr^.next<>nil do
        aptr := aptr^.next;
      aptr^.next := ahead;
    end;

  ahead := nil;
end;

function xreadkey: char;

var
  result: char;

begin
  result := readkey;

{$define pgdnbecomesgt}

{ change these extended keys: }

{    2nd Char key pressed    code returned       }
{    -------- -----------    -------------       }
{    I  73    PgUp           <                   }
{    Q  81    PgDn           space (or >)        }
{    G  71    Home           ^A (or ^)           }
{    O  79    End            ^E (or $)           }
{    ;  59    F1             ?                   }
{    K  75    left arrow     ^B (or backspace)   }
{    M  77    right arrow    ^F                  }
{    H  72    up arrow       ^P                  }
{    P  80    down arrow     ^N                  }
{    S  83    del            ^D                  }
{       15    shift-TAB      shiftedtab (209)    }

{       misc  alt-letter     misc. codes >209    }


  if (result=#0) and keypressed then
    begin
      result := readkey;

      if result='I' then
        result := '<'
      else if result='Q' then
{$ifdef pgdnbecomesgt}
        result := '>'
{$else}
        result := ' '
{$endif}
      else if result='G' then
{$ifdef homebecomescarat}
        result := '^'
{$else}
        result := ^A
{$endif}
      else if result='O' then
{$ifdef endbecomesdollar}
        result := '$'
{$else}
        result := ^E
{$endif}
      else if result=';' then
        result := '?'
      else if result='K' then
{$ifdef leftbecomesbackspace}
        result := #8
{$else}
        result := ^B
{$endif}
      else if result='M' then
        result := ^F
      else if result='H' then
        result := ^P
      else if result='P' then
        result := ^N
      else if result='S' then
        result := ^D
      else if result=#15 then
        result := shiftedtab

      else if result=#33 then
        result := altf
      else if result=#25 then
        result := altp
      else if result=#32 then
        result := altd
      else if result=#24 then
        result := alto
      else if result=#46 then
        result := altc

      else

{ ignore other extended keys }

        result := #0;
    end;

  xreadkey := result;
end;

procedure initialize;

var
  currparami: integer;
  currparams: string;
  nextparams: string;

begin
  oldtextattr := textattr;

  startupx := wherex;
  startupy := wherey;

  if paramcount=0 then
    usage;

  outputfn := '';
  title := 'Open';

  filemustexist := false;
  maxtofind := 1;
  warnifexists := false;
  allowmkdir := true;
  pattern := '*.*';
  currpath := '';
{ driveletters := 'abcdefghijklmnopqrstuvwxyz'; }
  driveletters :=   'cdefghijklmnopqrstuvwxyz';
  vikeys := false;

  dialogx := 2;
  dialogy := 2;
  dialogwidth := 74;
  dialogheight := 20;

  currparami := 1;
  while currparami<=paramcount do
    begin
      currparams := paramstr(currparami);
      if currparami<paramcount then
        nextparams := paramstr(currparami+1)
      else
        nextparams := '';

      if currparams='-?' then
        usage
      else if currparams='-o' then
        begin
          if nextparams='' then
            msgusage('-o requires a filename');
          outputfn := nextparams;
          inc(currparami);
        end
      else if currparams='-t' then
        begin
          if nextparams='' then
            msgusage('-t requires a string');
          title := nextparams;
          inc(currparami);
        end
      else if currparams='-e' then
        begin
          filemustexist := true;
        end
      else if currparams='-m' then
        begin
          if nextparams='' then
            msgusage('-m requires an integer');
          maxtofind := atoi(nextparams);
          if maxtofind=0 then
            msgusage('-m requires an integer');
          inc(currparami);
        end
      else if currparams='-w' then
        begin
          warnifexists := true;
        end
      else if currparams='-n' then
        begin
          allowmkdir := false;
        end
      else if currparams='-i' then
        begin
          if nextparams='' then
            msgusage('-i requires a pattern');
          pattern := nextparams;
          inc(currparami);
        end
      else if currparams='-p' then
        begin
          if nextparams='' then
            msgusage('-p requires a path');
          currpath := nextparams;
          inc(currparami);
        end
      else if currparams='-d' then
        begin
          if nextparams='' then
            msgusage('-d requires a list of letters');
          driveletters := nextparams;
          inc(currparami);
        end
      else if currparams='-v' then
        begin
          vikeys := true;
        end
      else
        msgusage('unknown parameter: '+currparams);

      inc(currparami);
    end;

  if outputfn='' then
    msgusage('-o is required');

  if currpath='' then
    begin
      {set path to current}
      getdir(0,currpath);
      currpath := lower(currpath);
    end;

  if right(currpath,1)=':' then
    begin
      {set path to current}
      getdir(1+ord(upcase(currpath[1]))-ord('A'),currpath);
      currpath := lower(currpath);
    end;

  assign(outputf,outputfn);
{$I-}
  rewrite(outputf);
{$I+}
  if ioresult<>0 then
    msgusage('could not write to '+outputfn);

  resultingfn := '';

  reusehead := nil;
end;

function getnewptr: filenodep;

var
  result: filenodep;

begin
  if reusehead<>nil then
    begin
      result := reusehead;
      reusehead := reusehead^.next;
    end
  else
    begin
      if memavail<10240 then
        result := nil
      else
        new(result);
    end;

  getnewptr := result;
end;

function longintdatetostring(time: longint): string;

var
  result: string;
  dt: datetime;

begin
  unpacktime(time,dt);
  result := wtoa(dt.year)+'-'+withzero(dt.month)+'-'+withzero(dt.day)+' '+
   withzero(dt.hour)+':'+withzero(dt.min);
  longintdatetostring := result;
end;

function insertedptrathead(var ahead: filenodep; filename: string;
 datetime: string; size: longint): boolean;

var
  result: boolean;
  newptr: filenodep;

begin
  result := true;

  newptr := getnewptr;
  if newptr=nil then
    begin
      result := false;
{}{}{}{}{} {need to handle out-of-memory better than this}
      gotoxy(1,1);
      writeln('out of memory');
    end
  else
    begin
      newptr^.next := ahead;
      ahead := newptr;
      newptr^.filename := filename;
      newptr^.datetime := datetime;
      newptr^.size := size;
    end;

  insertedptrathead := result;
end;

procedure initializedir;

var
  fileinfo: searchrec;
  done: boolean;

begin
  staticpopup(10,10,'Searching directory...');

  reuse(filehead);
  reuse(pathhead);

  findfirst(withbackslash(currpath)+pattern,directory,fileinfo);
  done := (doserror<>0);
  while not done do
    begin
      if (fileinfo.attr and directory)=0 then
        begin
          done := not
           insertedptrathead(filehead,
            lower(fileinfo.name),
            longintdatetostring(fileinfo.time),
            fileinfo.size);
        end
      else
        begin
          if (fileinfo.name<>'.') and (fileinfo.name<>'..') then
            done :=
             not insertedptrathead(pathhead,lower(fileinfo.name),'',0);
        end;

      if not done then
        begin
          findnext(fileinfo);
          done := (doserror<>0);
        end;
    end;

  sortlist(filehead);
  sortlist(pathhead);

{
  need to add it in by hand since our Netware 4.1 drive doesn't
  list . or .. (I don't know why!)
}
  if right(currpath,2)<>':\' then
    begin
{just assign to `done' -- not used}
      done := not insertedptrathead(pathhead,'..','',0);
    end;

  removepopup;
end;

procedure initializedrivelist;

var
  whichdisk: integer;
  done: boolean;
  fileinfo: searchrec;

begin
  staticpopup(10,10,'Finding valid drives...');

  reuse(drivehead);

  done := false;
  for whichdisk := 26 downto 1 do
    begin
      labels[whichdisk] := '';
      if not done then
        if pos(chr(ord('A')+whichdisk-1),upper(driveletters))<>0 then
          if diskfree(whichdisk)>=0 then
            begin
              labels[whichdisk] := chr(ord('A')+whichdisk-1)+':';
              findfirst(labels[whichdisk]+'\*.*',volumeid,fileinfo);
              if doserror=0 then
                labels[whichdisk] :=
                 labels[whichdisk]+' '+lower(unlabel(fileinfo.name));

              done := not
               insertedptrathead(drivehead,
                labels[whichdisk],
                '',
                diskfree(whichdisk));
          end;
    end;

  removepopup;
end;

{$ifdef old}
procedure saveunderdialog;

var
  anx,any: integer;
  regs: registers;

begin
  underdialog.count := 0;

  for anx := dialogx to dialogx+dialogwidth-1 do
    for any := dialogy to dialogy+dialogheight-1 do
      if underdialog.count<maxsavedbytes-1 then
        begin
          gotoxy(anx,any);

{read character+attribute from screen}
          regs.ah := 8;
          regs.bh := 0;
          intr($10,regs);

{first character, then attribute}
          inc(underdialog.count);
          underdialog.buffer[underdialog.count] := chr(regs.al);
          inc(underdialog.count);
          underdialog.buffer[underdialog.count] := chr(regs.ah);
        end;
end;

procedure restoreunderdialog;

var
  anx,any: integer;
  currbyte: integer;
  regs: registers;

begin
  currbyte := 0;
  for anx := dialogx to dialogx+dialogwidth-1 do
    for any := dialogy to dialogy+dialogheight-1 do
      if currbyte<underdialog.count then
        begin
          gotoxy(anx,any);

{first character, then attribute}
          inc(currbyte);
          regs.al := ord(underdialog.buffer[currbyte]);
          inc(currbyte);
          regs.bl := ord(underdialog.buffer[currbyte]);

{write character+attribute to screen}
          regs.ah := 9;
          regs.bh := 0;
          regs.cx := 1;
          intr($10,regs);

        end;
end;
{$endif}

procedure updatedialogtitle(newpath: string);

var
  titlewithpath: string;

begin
  singleboxwh(dialogx,dialogy,dialogwidth,dialogheight);

  titlewithpath := title+' - '+newpath;
  writexys(dialogx+1,dialogy,titlewithpath);
end;

procedure displaydialogoutline;

begin
  singleboxwh(dialogx,dialogy,dialogwidth,dialogheight);
  emptyboxwh(dialogx,dialogy,dialogwidth,dialogheight);

{
  writexys(dialogx+1,dialogy,title);
  updatedialogtitle(title);
}
end;

procedure fancyboxwh(isfancy: boolean; leftx,topy,width,height: integer);

begin
  if isfancy then
    begin
      enhancedvideo;
      doubleboxwh(leftx,topy,width,height);
      normalvideo;
    end
  else
    begin
      normalvideo;
      singleboxwh(leftx,topy,width,height);
      normalvideo;
    end;
end;

procedure displayfilepartoutline(isselected: boolean);

begin
  if isselected then
    doubleboxwh(dialogx+1,dialogy+1,44,dialogheight-2)
  else
    singleboxwh(dialogx+1,dialogy+1,44,dialogheight-2);

  writexys(dialogx+2,dialogy+1,'File');
end;

procedure displaypathpartoutline(isselected: boolean);

begin
  if isselected then
    doubleboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10)
  else
    singleboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10);

  writexys(dialogx+46,dialogy+1,'Path');
end;

procedure displaydrivepartoutline(isselected: boolean);

begin
  if isselected then
    doubleboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2)
  else
    singleboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2);

  writexys(dialogx+46,dialogy+10+1,'Drive');
end;

procedure displayokoutline(isselected: boolean);

begin
  if isselected then
    doubleboxwh(dialogx+45,dialogy+dialogheight-3,10,2)
  else
    singleboxwh(dialogx+45,dialogy+dialogheight-3,10,2);

  writexys(dialogx+46,dialogy+dialogheight-3,'OK');
end;

procedure displaycanceloutline(isselected: boolean);

begin
  if isselected then
    doubleboxwh(dialogx+55,dialogy+dialogheight-3,10,2)
  else
    singleboxwh(dialogx+55,dialogy+dialogheight-3,10,2);

  writexys(dialogx+56,dialogy+dialogheight-3,'Cancel');
end;

procedure updatefilepart(startptr: filenodep);

var
  aptr: filenodep;
  curry: integer;

begin
  emptyboxwh(dialogx+1,dialogy+1,44,dialogheight-2);

  curry := dialogy+2;
  aptr := startptr;
  while (aptr<>nil) and (curry<dialogy+dialogheight-2) do
    begin
      if aptr=startptr then
        reversevideo;
      writexys(dialogx+3,curry,leftjustify(aptr^.filename,12,' '));
      write(' ',aptr^.datetime);
      write(' ',rightjustify(ltoa(aptr^.size div 1024),9,' '),'k');
      normalvideo;

      aptr := aptr^.next;
      inc(curry);
    end;

{
  gotoxy(dialogx+2,dialogy+2);
}
end;

procedure updatepathpart(startptr: filenodep);

var
  aptr: filenodep;
  curry: integer;
{
  mangledcurrpath: string;
  partofpath: string;
}

begin
  emptyboxwh(dialogx+45,dialogy+1,dialogwidth-2-45,10);

  curry := dialogy+2;

{
  mangledcurrpath := withbackslash(currpath);
  while (mangledcurrpath<>'') and (curry<dialogy+10) do
    begin
      partofpath := copy(mangledcurrpath,1,pos('\',mangledcurrpath));
      mangledcurrpath := copy(mangledcurrpath,length(partofpath)+1,255);
      writexys(dialogx+45+2,curry,leftjustify(partofpath,12,' '));
      inc(curry);
    end;
}

  aptr := startptr;
  while (aptr<>nil) and (curry<dialogy+10) do
    begin
{}{}{}{} {want to show the tree so far non-indented}

      if aptr=startptr then
        reversevideo;
{indent 3}
      writexys(dialogx+45+2+3,curry,leftjustify(aptr^.filename,12,' '));
{
      write(' ',aptr^.datetime);
      write(' ',rightjustify(ltoa(aptr^.size div 1024),9,' '),'k');
}
      normalvideo;

      aptr := aptr^.next;
      inc(curry);
    end;

{
  gotoxy(dialogx+45+1,dialogy+1+1);
}
end;

procedure updatedrivepart(startptr: filenodep);

var
  aptr: filenodep;
  curry: integer;

begin
  emptyboxwh(dialogx+45,dialogy+10+1,dialogwidth-2-45,dialogheight-2-10-2);

  curry := dialogy+10+2;
  aptr := startptr;
  while (aptr<>nil) and (curry<dialogy+dialogheight-2-1-1) do
    begin
      if aptr=startptr then
        reversevideo;
      writexys(dialogx+46,curry,leftjustify(aptr^.filename,12,' '));
{
      write(' ',aptr^.datetime);
}
      write(' ',
       rightjustify(ltoa((aptr^.size+1024*1024-1) div 1024 div 1024),9,' '),
       'M');
      normalvideo;

      aptr := aptr^.next;
      inc(curry);
    end;

{
  gotoxy(dialogx+2,dialogy+2);
}
end;

procedure maybeincptr(var aptr: filenodep; count: integer);

var
  tempint: integer;

begin
  for tempint := 1 to count do
    if aptr^.next<>nil then
      aptr := aptr^.next;
end;

procedure maybedecptr(var aptr: filenodep; ahead: filenodep; count: integer);

var
  tempint: integer;

begin
  for tempint := 1 to count do
    if prevptr(aptr,ahead)<>nil then
      aptr := prevptr(aptr,ahead);
end;

procedure process;

type
  showingt=
   (
   onfirst,
     onfilepart,
     onpathpart,
     ondrivepart,
     onok,
     oncancel,
   onlast
   );

var
  currfileptr: filenodep;
  currpathptr: filenodep;
  currdriveptr: filenodep;
  done: boolean;
  onekey: char;
  showing: showingt;

begin
  drivehead := nil;
  initializedrivelist;

  saveareawh(dialogx,dialogy,dialogwidth,dialogheight,underdialog);

  displaydialogoutline;

  showing := onfilepart;

  displayfilepartoutline(showing=onfilepart);
  displaypathpartoutline(showing=onpathpart);
  displaydrivepartoutline(showing=ondrivepart);
  displayokoutline(showing=onok);
  displaycanceloutline(showing=oncancel);

  filehead := nil;
  pathhead := nil;

  initializedir;

  currfileptr := filehead;
  currpathptr := pathhead;
  currdriveptr := drivehead;

  updatefilepart(currfileptr);
  updatepathpart(currpathptr);
  updatedrivepart(currdriveptr);

  updatedialogtitle(currpath);

  done := false;
  while not done do
    begin
      case showing of
        onfilepart: updatefilepart(currfileptr);
        onpathpart: updatepathpart(currpathptr);
        ondrivepart: updatedrivepart(currdriveptr);
      else
        begin end;
      end;

      onekey := xreadkey;

      if onekey=tab then
        begin
          showing := succ(showing);
          if showing=onlast then
            showing := succ(onfirst);

          displayfilepartoutline(showing=onfilepart);
          displaypathpartoutline(showing=onpathpart);
          displaydrivepartoutline(showing=ondrivepart);
          displayokoutline(showing=onok);
          displaycanceloutline(showing=oncancel);
        end
      else if onekey=shiftedtab then
        begin
          showing := pred(showing);
          if showing=onfirst then
            showing := pred(onlast);

          displayfilepartoutline(showing=onfilepart);
          displaypathpartoutline(showing=onpathpart);
          displaydrivepartoutline(showing=ondrivepart);
          displayokoutline(showing=onok);
          displaycanceloutline(showing=oncancel);
        end
      else if onekey=altf then
        begin
          showing := onfilepart;

          displayfilepartoutline(showing=onfilepart);
          displaypathpartoutline(showing=onpathpart);
          displaydrivepartoutline(showing=ondrivepart);
          displayokoutline(showing=onok);
          displaycanceloutline(showing=oncancel);
        end
      else if onekey=altp then
        begin
          showing := onpathpart;

          displayfilepartoutline(showing=onfilepart);
          displaypathpartoutline(showing=onpathpart);
          displaydrivepartoutline(showing=ondrivepart);
          displayokoutline(showing=onok);
          displaycanceloutline(showing=oncancel);
        end
      else if onekey=altd then
        begin
          showing := ondrivepart;

          displayfilepartoutline(showing=onfilepart);
          displaypathpartoutline(showing=onpathpart);
          displaydrivepartoutline(showing=ondrivepart);
          displayokoutline(showing=onok);
          displaycanceloutline(showing=oncancel);
        end
      else if onekey=alto then
        begin
{}{}{}{} {they might have typed in a new filename}
          resultingfn := withbackslash(currpath)+currfileptr^.filename;
          done := true
        end
      else if onekey=altc then
        begin
          done := true;
        end
      else if onekey=esc then
        begin
          done := true;
        end
      else
        case showing of

          onfilepart:
            begin
              if onekey=#13 then
                begin
                  if currfileptr<>nil then
                    begin
{}{}{}{} {they might have typed in a new filename}
                      resultingfn :=
                       withbackslash(currpath)+currfileptr^.filename;
                      done := true
                    end;
                end
              else if onekey=^N then
                begin
                  maybeincptr(currfileptr,1);
                end
              else if vikeys and (onekey='j') then
                begin
                  maybeincptr(currfileptr,1);
                end
              else if onekey=^P then
                begin
                  maybedecptr(currfileptr,filehead,1);
                end
              else if vikeys and (onekey='k') then
                begin
                  maybedecptr(currfileptr,filehead,1);
                end
              else if onekey='>' then
                begin
                  maybeincptr(currfileptr,15);
                end
              else if onekey='<' then
                begin
                  maybedecptr(currfileptr,filehead,15);
                end
              else if onekey=^E then
                begin
                  while currfileptr^.next<>nil do
                    currfileptr := currfileptr^.next;
                end
              else if onekey=^A then
                begin
                  currfileptr := filehead;
                end
              else
                begin
                  {}
                end;
            end;

          onpathpart:
            begin
              if onekey=#13 then
                begin
                  if currpathptr<>nil then
                    begin
                      if currpathptr^.filename='..' then
                        currpath := withoutlastdir(currpath)
                      else
                        currpath :=
                         withbackslash(currpath)+currpathptr^.filename;

                      initializedir;
                      currfileptr := filehead;
                      currpathptr := pathhead;
                      updatefilepart(currfileptr);
                      updatepathpart(currpathptr);

                      updatedialogtitle(currpath);
                    end;
                end
              else if onekey=^N then
                begin
                  maybeincptr(currpathptr,1);
                end
              else if vikeys and (onekey='j') then
                begin
                  maybeincptr(currpathptr,1);
                end
              else if onekey=^P then
                begin
                  maybedecptr(currpathptr,pathhead,1);
                end
              else if vikeys and (onekey='k') then
                begin
                  maybedecptr(currpathptr,pathhead,1);
                end
              else if onekey='>' then
                begin
                  maybeincptr(currpathptr,7);
                end
              else if onekey='<' then
                begin
                  maybedecptr(currpathptr,pathhead,7);
                end
              else if onekey=^E then
                begin
                  while currpathptr^.next<>nil do
                    currpathptr := currpathptr^.next;
                end
              else if onekey=^A then
                begin
                  currpathptr := pathhead;
                end
              else
                begin
                  {}
                end;
            end;

          ondrivepart:
            begin
              if onekey=#13 then
                begin
                  if currdriveptr<>nil then
                    begin
                      getdir(1+ord(upcase(currdriveptr^.filename[1]))-ord('A'),
                       currpath);
                      currpath := lower(currpath);

                      initializedir;

                      currfileptr := filehead;
                      currpathptr := pathhead;

                      updatefilepart(currfileptr);
                      updatepathpart(currpathptr);
                      updatedrivepart(currdriveptr);

                      updatedialogtitle(currpath);
                    end;
                end
              else if onekey=^N then
                begin
                  maybeincptr(currdriveptr,1);
                end
              else if vikeys and (onekey='j') then
                begin
                  maybeincptr(currdriveptr,1);
                end
              else if onekey=^P then
                begin
                  maybedecptr(currdriveptr,drivehead,1);
                end
              else if vikeys and (onekey='k') then
                begin
                  maybedecptr(currdriveptr,drivehead,1);
                end
              else if onekey='>' then
                begin
                  maybeincptr(currdriveptr,3);
                end
              else if onekey='<' then
                begin
                  maybedecptr(currdriveptr,drivehead,3);
                end
              else if onekey=^E then
                begin
                  while currdriveptr^.next<>nil do
                    currdriveptr := currdriveptr^.next;
                end
              else if onekey=^A then
                begin
                  currdriveptr := drivehead;
                end
              else
                begin
                  {}
                end;
            end;

          onok:
            begin
              if onekey=#13 then
                begin
                  if currfileptr<>nil then
                    begin
{}{}{}{} {they might have typed in a new filename}
                      resultingfn :=
                       withbackslash(currpath)+currfileptr^.filename;
                      done := true;
                    end;
                end
              else if onekey=' ' then
                begin
                  if currfileptr<>nil then
                    begin
{}{}{}{} {they might have typed in a new filename}
                      resultingfn :=
                       withbackslash(currpath)+currfileptr^.filename;
                      done := true;
                    end;
                end
              else
                begin
                  {}
                end;
            end;

          oncancel:
            begin
              if onekey=#13 then
                begin
                  done := true;
                end
              else if onekey=' ' then
                begin
                  done := true;
                end
              else
                begin
                  {}
                end;
            end;
        end;
    end;

  restorearea(underdialog);
end;

procedure shutdown;

begin
  if resultingfn<>'' then
    writeln(outputf,resultingfn);
  close(outputf);

  gotoxy(startupx,startupy);
  textattr := oldtextattr;
end;

begin
  initialize;
  process;
  shutdown;
end.